(* -*- sml -*- *)
(**
 * @copyright (C) 2021 SML# Development Team.
 * @author UENO Katsuhiro
 * @author Huu-Duc Nguyen
 *)
structure BitmapCalc2 =
struct

  type loc = Loc.loc

  (*%
   * @formatter(Types.ty) Types.format_ty
   *)
  type ty =
      (*% @format(ty) ty *)
      Types.ty

  (*%
   * @formatter(TypedLambda.varInfo) TypedLambda.format_varInfo
   *)
  (*%
   * @prefix formatWithType_
   * @formatter(TypedLambda.varInfo) TypedLambda.formatWithType_varInfo
   *)
  type varInfo =
      (*% *)
      (*% @prefix formatWithType_ @format(v) v *)
      TypedLambda.varInfo

  (*%
   * @formatter(Types.exVarInfo) Types.format_exVarInfo
   *)
  (*%
   * @prefix formatWithType_
   * @formatter(Types.exVarInfo) Types.formatWithType_exVarInfo
   *)
  type exVarInfo =
      (*% *)
      (*% @prefix formatWithType_ @format(v) v *)
      Types.exVarInfo

  (*%
   * @formatter(TypedLambda.primInfo) TypedLambda.format_primInfo
   *)
  (*%
   * @prefix formatWithType_
   * @formatter(TypedLambda.primInfo) TypedLambda.formatWithType_primInfo
   *)
  type primInfo =
      (*% *)
      (*% @prefix formatWithType_ @format(x) x *)
      TypedLambda.primInfo

  (*%
   * @formatter(Types.btvEnv) Types.format_btvEnv
   *)
  type btvEnv =
      (*% @format(btv) btv *)
      Types.btvEnv

  (*%
    @formatter(TypedLambda.tlint) TypedLambda.format_tlint
   *)
  (*% @prefix formatWithType_
    @formatter(TypedLambda.tlint) TypedLambda.formatWithType_tlint
   *)
  datatype tlint = datatype TypedLambda.tlint

  (*%
    @formatter(TypedLambda.tlconst) TypedLambda.format_tlconst
   *)
  (*% @prefix formatWithType_
    @formatter(TypedLambda.tlconst) TypedLambda.formatWithType_tlconst
   *)
  datatype tlconst = datatype TypedLambda.tlconst

  (*%
    @formatter(TypedLambda.tlstring) TypedLambda.format_tlstring
   *)
  (*% @prefix formatWithType_
    @formatter(TypedLambda.tlstring) TypedLambda.formatWithType_tlstring
   *)
  datatype tlstring = datatype TypedLambda.tlstring

  (*%
    @formatter(RecordCalc.rcconst) RecordCalc.format_rcconst
   *)
  (*% @prefix formatWithType_
    @formatter(RecordCalc.rcconst) RecordCalc.formatWithType_rcconst
   *)
  datatype rcconst = datatype RecordCalc.rcconst

  (*%
   * @formatter(bool) SmlppgUtil.formatBinaryChoice
   * @formatter(RuntimeTypes.tag) RuntimeTypes.format_tag
   * @formatter(enclosedList) TermFormat.formatEnclosedList
   * @formatter(appList) TermFormat.formatAppList
   * @formatter(caseList) TermFormat.formatCaseList
   * @formatter(decList) TermFormat.formatDeclList
   * @formatter(ifCons) TermFormat.formatIfCons
   * @formatter(withType) formatWithType_varInfo
   * @formatter(FunLocalLabel.id) FunLocalLabel.format_id
   * @formatter(BuiltinPrimitive.cast) BuiltinPrimitive.format_cast
   * @formatter(RecordLabel.label) RecordLabel.format_label
   *)
  (*%
   * @prefix formatWithType_
   * @formatter(ty) format_ty
   * @formatter(btvEnv) format_btvEnv
   * @formatter(bool) SmlppgUtil.formatBinaryChoice
   * @formatter(RuntimeTypes.tag) RuntimeTypes.format_tag
   * @formatter(enclosedList) TermFormat.formatEnclosedList
   * @formatter(appList) TermFormat.formatAppList
   * @formatter(caseList) TermFormat.formatCaseList
   * @formatter(decList) TermFormat.formatDeclList
   * @formatter(ifCons) TermFormat.formatIfCons
   * @formatter(FunLocalLabel.id) FunLocalLabel.format_id
   * @formatter(BuiltinPrimitive.cast) BuiltinPrimitive.format_cast
   * @formatter(RecordLabel.label) RecordLabel.format_label
   *)
  datatype bcexp =
      (*%
       * @format({funExp, attributes, argExpList: arg args, resultTy, loc})
       * L8{ 2[
       *   "_FFIAPPLY"
       *   +1 funExp
       *   +1 args:appList(arg)("(",",",")")
       * ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({funExp, attributes, argExpList: arg args, resultTy, loc})
       * L8{ 2[
       *   "_FFIAPPLY"
       *   +1 funExp
       *   +1 args:appList(arg)("(",",",")")
       * ] }
       *)
      BCFOREIGNAPPLY of
      {
        funExp : bcexp,
        attributes : FFIAttributes.attributes,
        argExpList : bcexp list,
        resultTy : ty option,
        loc : loc
      } 
    | (*%
       * @format({attributes, resultTy, argVarList: arg args, bodyExp, loc})
       * L8{ 2[
       *   "_callback"
       *   +1 
       *    R1{ 2[
       *     "fn" +d args:enclosedList(arg:withType)
       *                              ("{",",","}")
       *          +d "=>" +1 bodyExp ] }
       * ] }
       *)
      (*% @prefix formatWithType_
       * @format({attributes, resultTy, argVarList: arg args, bodyExp, loc})
       * L8{ 2[
       *   "_callback"
       *   +1
       *    R1{ 2[
       *     "fn" +d args:enclosedList(arg)("{",",","}")
       *          +d "=>" +1 bodyExp ] }
       * ] }
       *)
      BCCALLBACKFN of
      { 
        attributes : FFIAttributes.attributes,
        argVarList : varInfo list,
        resultTy : ty option,
        bodyExp : bcexp,
        loc: loc
      } 
    | (*%
       * @format({const, loc}) const
       *)
      (*%
       * @prefix formatWithType_
       * @format({const, loc}) const
       *)
      BCCONSTANT of {const : rcconst, loc : loc}
    | (*%
       * @format({string, loc}) string
       *)
      (*%
       * @prefix formatWithType_
       * @format({string, loc}) string
       *)
      BCSTRING of {string : tlstring, loc : loc}
    | (*%
       * @format({varInfo, loc}) varInfo
       *)
      (*%
       * @prefix formatWithType_
       * @format({varInfo, loc}) varInfo
       *)
      BCVAR of {varInfo : varInfo, loc : loc}
    | (*%
       * @format({exVarInfo, loc}) exVarInfo
       *)
      (*%
       * @prefix formatWithType_
       * @format({exVarInfo, loc}) exVarInfo
       *)
      BCEXVAR of {exVarInfo : exVarInfo, loc : loc}
    | (*%
       * @format({primInfo, argExpList: arg args, instTyList: ty tys,
       *          instTagList: tag tags, instSizeList: size sizes, loc})
       * L8{ 2[ "_PRIMAPPLY(" primInfo ")"
       *        tys:ifCons()(
       *          +1 L2{ tys:appList(ty)("(",",",")")
       *                 +1 "/t" +d tags:appList(tag)("(",",",")")
       *                 +1 "/s" +d sizes:appList(size)("(",",",")") }
       *        )
       *        +1 args:appList(arg)("(",",",")") ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({primInfo, argExpList: arg args, instTyList: ty tys,
       *          instTagList: tag tags, instSizeList: size sizes, loc})
       * L8{ 2[ "_PRIMAPPLY(" primInfo ")"
       *        tys:ifCons()(
       *          +1 L2{ tys:appList(ty)("(",",",")")
       *                 +1 "/" +d tags:appList(tag)("(",",",")")
       *                 +1 "/" +d sizes:appList(size)("(",",",")") }
       *        )
       *        +1 args:appList(arg)("(",",",")") ] }
       *)
      BCPRIMAPPLY of
      {
        primInfo : primInfo,
        argExpList : bcexp list,
        instTyList : ty list,
        instTagList : bcexp list,
        instSizeList : bcexp list,
        loc : loc
      }
    | (*%
       * @format({funExp, argExpList: arg args, funTy, loc})
       * L8{ 2[
       *   funExp
       *   +1 args:appList(arg)("(",",",")")
       * ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({funExp, argExpList: arg args, funTy, loc})
       * L8{ 2[
       *   L2{ funExp +1 ":" +d funTy }
       *   +1 args:appList(arg)("(",",",")")
       * ] }
       *)
      BCAPPM of
      {
        funExp : bcexp,
        argExpList : bcexp list,
        funTy : ty,
        loc : loc
      }
    | (*%
       * @format({localDecl, mainExp, loc})
       * R1{ "let" 2[ +1 localDecl ]
       *     +1 "in" +1 mainExp }
       *)
      (*%
       * @prefix formatWithType_
       * @format({localDecl, mainExp, loc})
       * R1{ "let" 2[ +1 localDecl ]
       *     +1 "in" +1 mainExp }
       *)
      BCLET of
      {
        localDecl : bcdecl,
        mainExp : bcexp,
        loc : loc
      }
    | (*%
       * @format({fieldList: field fields,
       *          recordTy, isMutable, clearPad, allocSizeExp,
       *          bitmaps: bm bms, loc})
       * L2{ fields:enclosedList(field)("{",",","}")
       *     +1 "/t" +d allocSizeExp
       *     +1 "/b" +d bms:appList(bm)("(",",",")") }
       * @format:field({fieldExp, fieldTy, fieldLabel, fieldSize, fieldTag,
       *                fieldIndex})
       * !R1{ L2{ "#" fieldLabel +1 "/i" +d fieldIndex +1 "/s" +d fieldSize }
       *      +d "=" +1 fieldExp }
       * @format:bm({bitmapIndex, bitmapExp})
       * L8{ "[" !N0{ bitmapIndex "]" }
       *     +1 bitmapExp }
       *)
      (*%
       * @prefix formatWithType_
       * @format({fieldList: field fields,
       *          recordTy, isMutable, clearPad, allocSizeExp,
       *          bitmaps: bm bms, loc})
       * L2{ L2{ fields:enclosedList(field)("{",",","}")
       *         +1 "/t" +d allocSizeExp
       *         +1 "/" +d bms:appList(bm)("(",",",")") }
       *     +1 ":" +d recordTy }
       * @format:field({fieldExp, fieldTy, fieldLabel, fieldSize, fieldTag,
       *                fieldIndex})
       * !R1{ L2{ "#" fieldLabel +1 "/" +d fieldIndex +1 "/" +d fieldSize }
       *      +d "=" +1 L2{ fieldExp +1 ":" +d fieldTy } }
       * @format:bm({bitmapIndex, bitmapExp})
       * L8{ "[" !N0{ bitmapIndex "]" }
       *     +1 bitmapExp }
       *)
      BCRECORD of
      {
        fieldList : {fieldExp : bcexp,
                     fieldTy : ty,
                     fieldLabel : RecordLabel.label,
                     fieldSize : bcexp,
                     fieldTag : bcexp,
                     fieldIndex : bcexp} list,
        recordTy : ty,
        isMutable : bool,
        clearPad : bool,
        allocSizeExp : bcexp,
        bitmaps : {bitmapIndex : bcexp,
                   bitmapExp : bcexp} list,
        loc : loc
      }
    | (*%
       * @format({recordExp, indexExp, label, recordTy, resultTy, resultSize,
       *          resultTag, loc})
       * L2{
       *   L8{ 2[ L2{ "#" label +1 "/i" +d indexExp
       *                        +1 "/r" +d resultTag }
       *          +1 recordExp ] }
       *   +1 "/s" +d resultSize }
       *)
      (*%
       * @prefix formatWithType_
       * @format({recordExp, indexExp, label, recordTy, resultTy, resultSize,
       *          resultTag, loc})
       * L2{
       *   L8{ 2[ L2{ "#" label +1 "/i" +d indexExp
       *                        +1 "/r" +d resultTag }
       *          +1 L2{ recordExp +1 ":" +d recordTy } ] }
       *   +1 ":" +d resultTy
       *   +1 "/s" +d resultSize }
       *)
      BCSELECT of
      {
        recordExp : bcexp,
        indexExp : bcexp,
        label : RecordLabel.label,
        recordTy : ty,
        resultTy : ty,
        resultSize : bcexp,
        resultTag : bcexp,
        loc : loc
      }
    | (*%
       * @format({recordExp, recordTy, indexExp, label, valueExp, valueTy,
       *          valueTag, valueSize, loc})
       * L8{ 2[ recordExp
       *        +1 "#" +d "{"
       *          !N0{ L2{ "#" label +1 "/i" +d indexExp } +d "="
       *               2[ +1 L2{ valueExp
       *                         +1 "/t" +d valueTag
       *                         +1 "/s" +d valueSize } ] } "}" ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({recordExp, recordTy, indexExp, label, valueExp, valueTy,
       *          valueTag, valueSize, loc})
       * L8{ 2[ L2{ recordExp +1 ":" +d recordTy }
       *        +1 "#" +d "{"
       *          !N0{ L2{ "#" label +1 "/" +d indexExp } +d "="
       *               2[ +1 L2{ valueExp
       *                         +1 ":" +d valueTy
       *                         +1 "/" +d valueTag
       *                         +1 "/" +d valueSize } ] } "}" ] }
       *)
      BCMODIFY of
      {
        recordExp : bcexp,
        recordTy : ty,
        indexExp : bcexp,
        label : RecordLabel.label,
        valueExp : bcexp,
        valueTy : ty,
        valueTag : bcexp,
        valueSize : bcexp,
        loc : loc
      }
    | (*%
       * @format({argExp, resultTy, loc})
       * !R1{ 2[ "raise" +1 argExp ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({argExp, resultTy, loc})
       * L2{ R1{ 2[ "raise" +1 argExp ] +1 } ":" +d resultTy }
       *)
      BCRAISE of
      {
        argExp : bcexp,
        resultTy : ty,
        loc : loc
      }
    | (*%
       * @format({tryExp, exnVar, handlerExp, resultTy, loc})
       * R1{ "try"
       *     2[ +1 tryExp ]
       *     +1 "handle" +d { exnVar:withType +1 "=>" }
       *     2[ +1 handlerExp ]
       *     +1 "end" }
       *)
      (*%
       * @prefix formatWithType_
       * @format({tryExp, exnVar, handlerExp, resultTy, loc})
       * L2{
       * R1{ "try"
       *     2[ +1 tryExp ]
       *     +1 "handle" +d { exnVar +1 "=>" }
       *     2[ +1 handlerExp ]
       *     +1 "end" }
       * +1 ":" +d resultTy }
       *)
      BCHANDLE of
      {
        tryExp : bcexp,
        exnVar : varInfo,
        handlerExp : bcexp,
        resultTy : ty,
        loc : loc
      }
    | (*%
       * @format({catchLabel, argVarList: arg args, catchExp, tryExp, resultTy,
       *          loc})
       * R0{ tryExp
       *     +1 
       *     !R0{ "_catch" +d
       *          L8{ catchLabel
       *              +1 1[ args:appList(arg)("{",",","}") ] }
       *          +d "=>" 1[ +1 catchExp ] } }
       *)
      (*%
       * @prefix formatWithType_
       * @format({catchLabel, argVarList: arg args, catchExp, tryExp, resultTy,
       *          loc})
       * L2{
       *   R0{ tryExp
       *     +1 
       *     !R0{ "_catch" +d
       *          L8{ catchLabel
       *              +1 1[ args:appList(arg)("{",",","}") ] }
       *          +d "=>" 1[ +1 catchExp ] } }
       *   +1 ":" +d resultTy }
       *)
      (* lightweight exception that unwind call stack *)
      BCCATCH of
      {
        catchLabel : FunLocalLabel.id,
        argVarList : varInfo list,
        catchExp : bcexp,
        tryExp : bcexp,
        resultTy : ty,
        loc : loc
      }
    | (*%
       * @format({catchLabel, argExpList: arg args, resultTy, loc})
       * R0{ "_throw"
       *     1[ +1 L8{ catchLabel
       *               +1 1[ args:appList(arg)("{",",","}") ] } ] }
       *)
      (*% @prefix formatWithType_
       * @format({catchLabel, argExpList: arg args, resultTy, loc})
       * L2{
       *   R0{ "_throw"
       *     1[ +1 L8{ catchLabel
       *               +1 1[ args:appList(arg)("{",",","}") ] } ] }
       *   +1 ":" +d resultTy }
       *)
      (* lightweight exception that does not unwind call stack *)
      BCTHROW of
      {
        catchLabel : FunLocalLabel.id,
        argExpList : bcexp list,
        resultTy : ty,
        loc : loc
      }
    | (*%
       * @format({argVarList: arg args, retTy, bodyExp, loc})
       * R1{ "fn" +d args:appList(arg)("(",",",")") +d "=>"
       *     3[ +1 bodyExp ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({argVarList: arg args, retTy, bodyExp, loc})
       * L2{ R1{ "fn" +d args:appList(arg)("(",",",")") +d "=>"
       *        3[ +1 bodyExp ] }
       *     +1 ":" +d retTy }
       *)
      BCFNM of
      {
        argVarList : varInfo list,
        bodyExp : bcexp,
        retTy : ty,
        loc : loc
      }
    | (*%
       * @format({btvEnv:btv, expTyWithoutTAbs, exp, loc})
       * "[" !R1{ btv "." +1 exp } "]"
       *)
      (*%
       * @prefix formatWithType_
       * @format({btvEnv:btv, expTyWithoutTAbs, exp, loc})
       * "[" !R1{ btv "." +1 L2{ exp +1 ":" +d expTyWithoutTAbs } } "]"
       *)
      BCPOLY of
      {
        btvEnv : btvEnv,
        expTyWithoutTAbs : ty,
        exp : bcexp,
        loc : loc
      }
    | (*%
       * @format({exp, expTy, instTyList: ty tys, loc})
       * L8{ 2[ exp
       *        +1 tys:enclosedList(ty)("(",",",")") ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({exp, expTy, instTyList: ty tys, loc})
       * L8{ 2[ L2{ exp +1 ":" +d expTy }
       *        +1 tys:enclosedList(ty)("(",",",")") ] }
       *)
      BCTAPP of
      {
        exp : bcexp,
        expTy : ty,
        instTyList : ty list,
        loc : loc
      }
    | (*%
       * @format({switchExp, expTy, branches: branch branches, defaultExp,
       *          resultTy, loc})
       * { 2[ "case" +1 switchExp +1 "of" ] }
       * branches:caseList(branch)(2[+1], +1 "|" +d,
       *                           !R1{ 2[ "_" +d "=>" +1 defaultExp ] })
       * @format:branch({constant, branchExp})
       * !R1{ 2[ constant +d "=>" +1 branchExp ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({switchExp, expTy, branches: branch branches, defaultExp,
       *          resultTy, loc})
       * L2{
       * { 2[ "case" +1 L2{ switchExp +1 ":" +d expTy } +1 "of" ] }
       * branches:caseList(branch)(2[+1], +1 "|" +d,
       *                           !R1{ 2[ "_" +d "=>" +1 defaultExp ] })
       * +1 ":" +d resultTy }
       * @format:branch({constant, branchExp})
       * !R1{ 2[ constant +d "=>" +1 branchExp ] }
       *)
      BCSWITCH of
      {
        switchExp : bcexp,
        expTy : ty,
        branches : {constant : tlint, branchExp : bcexp} list,
        defaultExp : bcexp,
        resultTy : ty,
        loc : loc
      }
    | (*%
       * @format({exp, expTy, targetTy, cast, loc})
       * cast "(" exp ")"
       *)
      (*%
       * @prefix formatWithType_
       * @format({exp, expTy, targetTy, cast, loc})
       * cast "(" !L2{ L2{ exp +1 ":" +d expTy } +1 ":" +d targetTy} ")"
       *)
      BCCAST of
      {
        exp : bcexp,
        expTy : ty,
        targetTy : ty,
        cast : BuiltinPrimitive.cast,
        loc : loc
      }

  and bcdecl =
      (*%
       * @format({boundVar, boundExp, loc})
       * !R1{ "val" +d boundVar:withType +d "="
       *      4[ +1 boundExp ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({boundVar, boundExp, loc})
       * !R1{ "val" +d boundVar +d "="
       *      4[ +1 boundExp ] }
       *)
      BCVAL of
      {
        boundVar : varInfo,
        boundExp : bcexp,
        loc : loc
      }
    | (*%
       * @format({recbindList: bind binds, loc})
       * !R1{ binds:decList(bind)("val" +d "rec" +d, +1 "and" +d) }
       * @format:bind({boundVar, boundExp})
       * boundVar:withType +d "=" 4[ +1 boundExp ]
       *)
      (*%
       * @prefix formatWithType_
       * @format({recbindList: bind binds, loc})
       * !R1{ binds:decList(bind)("val" +d "rec" +d, +1 "and" +d) }
       * @format:bind({boundVar, boundExp})
       * boundVar +d "=" 4[ +1 boundExp ]
       *)
      BCVALREC of
      {
        recbindList : {boundVar : varInfo, boundExp: bcexp } list,
        loc : loc
      }
    | (*%
       * @format({exVarInfo, provider, loc})
       * !R1{ "extern" +d "val" +d exVarInfo }
       *)
      (*%
       * @prefix formatWithType_
       * @format({exVarInfo, provider, loc})
       * !R1{ "extern" +d "val" +d exVarInfo }
       *)
      BCEXTERNVAR of
      {
        exVarInfo: exVarInfo,
        provider: Types.provider,
        loc: loc
      }
    | (*%
       * @format({weak, exVarInfo, exp, loc})
       * !R1{ "export" +d "val" +d exVarInfo
       *      2[ +d "=" +1 exp ] }
       *)
      (*%
       * @prefix formatWithType_
       * @format({weak, exVarInfo, exp, loc})
       * !R1{ "export" +d "val" +d exVarInfo
       *      2[ +d "=" +1 exp ] }
       *)
      BCEXPORTVAR of
      {
        weak : bool,
        exVarInfo : exVarInfo,
        exp : bcexp,
        loc : loc
      }

end
